home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / prim / lisp-file-db.el.z / lisp-file-db.el
Encoding:
Text File  |  1998-05-21  |  1.6 KB  |  40 lines
  1. (defvar *default-db-name* (expand-file-name "~/.xemacs/lisp-file-database")
  2.   "Default location of the database")
  3.  
  4. (defun build-lisp-file-db (&optional db-name path rebuild)
  5.   "Create a database of all lisp files in the directories given by PATH.
  6. DB-NAME is the database name, defaulting to *default-db-name*
  7. PATH is a list of directories to search, defaulting to load-path.
  8. REBUILD "
  9.   (let ((path (or path load-path))
  10.     (db (open-database (or db-name *default-db-name*) nil nil "rw+")))
  11.     ;; For each entry in path, find all files in it and put them in
  12.     ;; the database.
  13.     (dolist (dir path)
  14.       (dolist (file (directory-files dir t nil t t))
  15.     ;; Separate the file name and the directory.  The key is the
  16.     ;; filename, and the value is the whole pathname.  However, if
  17.     ;; the key already exists, DON'T put that entry in.  We want
  18.     ;; things that occur first in load-path to override entries
  19.     ;; later in load-path
  20.     (let ((fname (file-name-nondirectory file)))
  21.       (put-database fname file db nil))))))
  22.  
  23. (defun show-lisp-db (&optional db-name)
  24.   (let ((db (open-database (or db-name *default-db-name*) nil nil "r"))
  25.     (entries '()))
  26.     (map-database #'(lambda (key val)
  27.               (push (cons key val) entries))
  28.           db)
  29.     (nreverse entries)))
  30.  
  31. (defun lookup-lisp-file-db (file &optional db-name)
  32.   (let ((name (file-name-nondirectory file))
  33.     (db (open-database (or db-name *default-db-name*) nil nil "r")))
  34.     (do* ((ext '("" ".elc" ".el") (rest ext))
  35.      (entry (get-database (concat name (first ext)) db)
  36.         (get-database (concat name (first ext)) db)))
  37.     ((or entry (null ext)) entry)
  38.       ())))
  39.     
  40.